home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / compuserve-file-archive / 09 Application Software / CAL98.BIN (.txt) < prev    next >
Commodore BASIC  |  2019-04-13  |  12KB  |  624 lines
  1. 0 GOTO 2000:REM SAVE "CALENDAR9.8",8
  2. 1 LIST 1   -1999:REM PROGRAM
  3. 2 LIST 2000-2999:REM PROGRAM
  4. 3 LIST 3000-3999:MENU
  5. 4 LIST 4000-4999:INPUT DATA
  6. 5 LIST 5000-5999:SET UP VARIABLES
  7. 6 LIST 6000-6999:SET UP EMPTY STRINGS
  8. 7 LIST 7000-7999:REM SAVE TO DISK
  9. 8 LIST 8000-8999:REM READ FROM DISK
  10. 9 LIST 9000-9499:REM OPEN FILES
  11. 10 LIST 10000-10999:REM REFERENCE
  12. 11 LIST 11000-11999:REM NOT USED
  13. 12 LIST 12000-12999:REM PRINT CALENDER
  14. 13 LIST 13000-13999:CLEAR SCREEN
  15. 14 LIST 14000-14999:SET PRINTER PARAMTERS
  16. 15 LIST 15000-15999:SCRATCH OLD FILE
  17. 16 LIST 16000-16999:MAKE Y(1)-Y(12) DATA
  18. 17 LIST 17000-17999:DISPLAY ALTERED DATES
  19. 18 LIST 18000-18999:RECOVER FROM DISK ERROR
  20. 19 LIST 19000-19999:PRINT PRINTER OFF LINE MESSAGE
  21. 20 LIST 20000-20999:WELCOME
  22. 49 LIST 4900-4999:REM MAKE STRING
  23. 95 LIST 9500-9999:REM CLOSE FILES
  24. 100 REM ******************************
  25. 101 REM *                            *
  26. 102 REM *       A.RYDBERG            *
  27. 103 REM *    RFD #1 BOX 46C          *
  28. 104 REM *     STERLING CT. 06377     *
  29. 105 REM *                            *
  30. 106 REM *  ALL RIGHTS RESERVED       *
  31. 107 REM *                            *
  32. 108 REM ******************************
  33. 1998 :
  34. 1999 :
  35. 2000 REM PROGRAM
  36. 2004 GOSUB 20000
  37. 2005 LF=7: P$(4)=" "
  38. 2010 GOSUB 13000:REM CLEAR
  39. 2012 POKE 53272,23:REM LOWER CASE
  40. 2020 GOSUB 5000:REM DIM VARIABLES
  41. 2024 GOSUB 6000:REM SET UP EMPTY STRINGS
  42. 2030 GOSUB 3000:REM MAIN MENU
  43. 2996 POKE 53272,21:REM ALL CAPS ON EXIT
  44. 2997 END
  45. 2998 :
  46. 2999 :
  47. 3000 REM MENU
  48. 3005 GOSUB 13000
  49. 3006 PRINT " "
  50. 3007 PRINT "       ENTER 1 THRU 6"
  51. 3008 PRINT " "
  52. 3010 PRINT "       1) READ FROM DISK  "
  53. 3020 PRINT "       2) ENTER NEW DATA"
  54. 3030 PRINT "       3) SAVE TO DISK    "
  55. 3040 PRINT "       4) PRINT CALENDAR"
  56. 3050 PRINT "       5) END PROGRAM"
  57. 3054 PRINT "       6) SET PTR PARA. "R$(1)R$(3)R$(4)
  58. 3055 PRINT "       7) SCRATCH OLD FILE"
  59. 3056 PRINT "       8) DISPLAY ALTERED DATES"
  60. 3057 PRINT "       9) RECOVER FROM DISK ERROR"
  61. 3059 PRINT "  "
  62. 3060 INPUT" ENTER NEXT COMMAND";X
  63. 3061 IF X>9 OR X<1 THEN 3060
  64. 3065 ON X GOSUB 8000,4000,7000,12000,3800,14000,15000,17000,18000
  65. 3070 IF X=5 THEN RETURN
  66. 3080 GOTO 3000
  67. 3800 RETURN
  68. 3998 :
  69. 3999 :
  70. 4000 REM INPUT DATA
  71. 4001 PRINT "    ------------------------------"
  72. 4005 PRINT "(0) TO QUIT DATA INPUT"
  73. 4010 INPUT"     MONTH (1 TO 12) ";MO
  74. 4011 IF MO>12 OR MO<0 THEN 4010
  75. 4012 IF MO=0 THEN 4498
  76. 4020 INPUT"     DAY  (1 TO 31) ";DA
  77. 4021 IF DA>31 OR DA<0 THEN 4020
  78. 4030 IF DA=0 THEN 4498
  79. 4040 GOSUB 4800:REM MAKE SQUARE
  80. 4045 L=2
  81. 4050 GOSUB 4900:REM GET CHAR
  82. 4052 IF A$="Q" THEN 4430
  83. 4055 GOSUB 4800:REM MAKE SQUARE
  84. 4070 L=3:GOSUB 4700
  85. 4075 IF A$="Q" THEN 4430
  86. 4080 L=4:GOSUB 4700
  87. 4430 GOTO 4000
  88. 4440 :
  89. 4498 RETURN
  90. 4499 :
  91. 4700 REM CHOOSE INPUT
  92. 4701 PRINT S$"[194]IRTHDAY--(F1)  LINE# "L-1
  93. 4702 PRINT S$"[215]EDDING [193]-(F3)"
  94. 4703 PRINT S$"[200]OLIDAY--(F5)"
  95. 4704 PRINT S$"OTHER-----(F7)"
  96. 4706 PRINT S$"QUIT DATE-(Q)"
  97. 4710 PRINT"    OCCASION"
  98. 4720 GET A$: IF A$="" THEN 4720
  99. 4721 IF ASC(A$)=81 THEN 4730
  100. 4725 IF ASC(A$)<133 THEN 4720
  101. 4726 IF ASC(A$)>136 THEN 4720
  102. 4730 IF ASC(A$)=134 THEN D$(MO,DA,L)="*[215]EDDING [193] ":GOTO 4790:REM F3
  103. 4735 IF ASC(A$)=135 THEN D$(MO,DA,L)="* [200]OLLIDAY ":GOTO 4790:REM F5
  104. 4740 IF ASC(A$)=133 THEN D$(MO,DA,L)="* [194]IRTHDAY ":GOTO 4790:REM F1
  105. 4750 IF ASC(A$)=136 THEN 4760 :REM F7
  106. 4755 IF A$="Q" THEN 4798
  107. 4760 GOSUB 4800:REM MAKE SQUARE
  108. 4780 GOSUB 4900:REM GET CHAR
  109. 4785 IF A$="Q" THEN 4430
  110. 4790 GOSUB 4800
  111. 4798 RETURN
  112. 4799 :
  113. 4800 REM PRINT SQUARE
  114. 4830 GOSUB 13000:REM CLEAR
  115. 4831 FOR I=1 TO 3:PRINT CHR$(17)
  116. 4832 PRINT" "
  117. 4833 PRINT S$M$(MO)
  118. 4834 PRINT " "
  119. 4844 PRINT S$"************"
  120. 4845 PRINT S$D$(MO,DA,1)"*"
  121. 4846 PRINT S$D$(MO,DA,2)"*"
  122. 4847 PRINT S$D$(MO,DA,3)"*"
  123. 4848 PRINT S$D$(MO,DA,4)"*"
  124. 4849 PRINT S$"************"
  125. 4897 RETURN
  126. 4898 :
  127. 4899 :
  128. 4900 REM MAKE STRING:L NEEDED
  129. 4908 PRINT "            (ENTER Q TO END THIS DATE[160])
  130. 4909 [153] "            ??????????"
  131. 4910 [133] "ENTER DATA";A$
  132. 4911 [139] A$[178]"Q" [167] 4997
  133. 4912 [139] [195](A$)[177]10 [167] [153]"ONLY 10 ALLOWED":[137] 4909
  134. 4913 [139] A$[178]"GOTO"[167] D$(MO,DA,L)[178]"*          "
  135. 4920 [139] [195] (A$)[178]1 [167] D$(MO,DA,L)[178]"*     "[170]A$[170]"    "
  136. 4930 [139] [195] (A$)[178]2 [167] D$(MO,DA,L)[178]"*     "[170]A$[170]"   "
  137. 4932 [139] [195] (A$)[178]3 [167] D$(MO,DA,L)[178]"*    "[170]A$[170]"   "
  138. 4934 [139] [195] (A$)[178]4 [167] D$(MO,DA,L)[178]"*   "[170]A$[170]"   "
  139. 4936 [139] [195] (A$)[178]5 [167] D$(MO,DA,L)[178]"*   "[170]A$[170]"  "
  140. 4938 [139] [195] (A$)[178]6 [167] D$(MO,DA,L)[178]"*  "[170]A$[170]"  "
  141. 4940 [139] [195] (A$)[178]7 [167] D$(MO,DA,L)[178]"*  "[170]A$[170]" "
  142. 4942 [139] [195] (A$)[178]8 [167] D$(MO,DA,L)[178]"* "[170]A$[170]" "
  143. 4944 [139] [195] (A$)[178]9 [167] D$(MO,DA,L)[178]"* "[170]A$
  144. 4946 [139] [195] (A$)[178]10 [167] D$(MO,DA,L)[178]"*"[170]A$
  145. 4997 [142]
  146. 4998 :
  147. 4999 :
  148. 5000 [143] SET UP VARIABLES
  149. 5010 [134] D$(12,31,4):[143] MONTH,DAY,LINE
  150. 5020 [134] M$(12)
  151. 5025 [134] Y(12)
  152. 5030 M$(1) [178] "MID$ANUARY"
  153. 5031 M$(2) [178] "ASCEBRUARY"
  154. 5032 M$(3) [178] "(null)ARCH"
  155. 5033 M$(4) [178] "ATNPRIL"
  156. 5034 M$(5) [178] "(null)AY"
  157. 5035 M$(6) [178] "MID$UNE"
  158. 5036 M$(7) [178] "MID$ULY"
  159. 5037 M$(8) [178] "ATNUGUST"
  160. 5038 M$(9) [178] "(null)EPTEMBER"
  161. 5039 M$(10) [178] "(null)CTOBER"
  162. 5040 M$(11) [178] "(null)OVEMBER"
  163. 5041 M$(12) [178] "STR$ECEMBER"
  164. 5050 [134] Z(12)
  165. 5060 [129] I[178]1 [164] 12:Z(I)[178]31:[130] I
  166. 5070 Z(4)[178]30:Z(6)[178]30:Z(9)[178]30:Z(11)[178]30:Z(2)[178]29
  167. 5170 S$[178]"         "
  168. 5180 BK$[178]"*          "
  169. 5190 P$(4)[178]" "
  170. 5997 [142]
  171. 5998 :
  172. 5999 :
  173. 6000 [143] SET UP EMPTY STRINGS
  174. 6005 [129] I[178]1 [164] 6:[153]" ":[130] I
  175. 6006 [153] "     **** (null)ATNRIGHT$(null)CLOSE****  "
  176. 6010 [129] K[178]1 [164] 12
  177. 6020 [129] J[178]2 [164] 4
  178. 6030 [129] I[178]1 [164] 31
  179. 6040 D$(K,I,J)[178]"*          "
  180. 6050 [130] I
  181. 6060 [130] J
  182. 6070 [130] K
  183. 6080 :
  184. 6110 [129] K[178]1 [164] 12
  185. 6130 [129] I[178]1 [164] 31
  186. 6132 I$[178][196](I)
  187. 6134 [139] [195]([196](I))[178]3 [167] 6138
  188. 6136 I$[178]I$[170]" "
  189. 6138 [143] NUMBER LENGTHS EQUAL
  190. 6140 D$(K,I,1)[178]"*"[170]I$[170]"       "
  191. 6150 [130] I
  192. 6170 [130] K
  193. 6997 [142]
  194. 6998 :
  195. 6999 :
  196. 7000 [143] SAVE TO DISK
  197. 7005 [153] "SAVING DATA"
  198. 7010 [133] "DATA NAME";N$
  199. 7015 [139] N$[178]"Q" [167] [142]
  200. 7016 [139] N$[178]"" [167] 7010
  201. 7020 N$[178]N$[170]",S,W"
  202. 7040 [141] 9000:[143] OPEN
  203. 7100 [129] K[178]1 [164] 12
  204. 7110 [129] I[178]1 [164] 31
  205. 7113 :
  206. 7115 [139] D$(K,I,2)[178]"*          " [167] 7150
  207. 7120 [129] J[178]1 [164] 4
  208. 7121 [139] ST[179][177]0 [167] 7200
  209. 7122 K$[178][196](K):I$[178][196](I):J$[178][196](J)
  210. 7123 [152]2,K$
  211. 7124 [152]2,I$
  212. 7125 [152]2,J$
  213. 7130 [152]2,D$(K,I,J)
  214. 7135 [153] "S  "D$(K,I,J),M$(K)
  215. 7140 [130] J
  216. 7145 :
  217. 7150 [130] I
  218. 7160 [130] K
  219. 7200 [141] 9500:[143] CLOSE
  220. 7350 N$[178]""
  221. 7500 [142]
  222. 7998 :
  223. 7999 :
  224. 8000 [143] READ FROM DISK
  225. 8005 [153] "READING DATA"
  226. 8010 [133] "DATA NAME";N$
  227. 8015 [139] N$[178]"Q" [167] [142]
  228. 8016 [139] N$[178]"" [167] 8010
  229. 8020 N$[178]N$[170]",S,R"
  230. 8030 [141] 9000
  231. 8100 :
  232. 8125 [139] ST[179][177]0 [167] 8300
  233. 8127 [132]2,K$
  234. 8128 [132]2,I$
  235. 8129 [132]2,J$
  236. 8130 K[178][197](K$):I[178][197](I$):J[178][197](J$)
  237. 8132 [132]2,D$(K,I,J)
  238. 8135 [153] "R  "D$(K,I,J),M$(K)
  239. 8140 [137] 8125
  240. 8150 :
  241. 8300 [141] 9500
  242. 8350 N$[178]""
  243. 8500 [142]
  244. 8798 :
  245. 8997 [142]
  246. 8998 :
  247. 8999 :
  248. 9000 [143] OPEN DISK FILES N$ NEEDED
  249. 9010 [159] 15,8,15
  250. 9020 [159] 2,8,2,N$
  251. 9498 [142]
  252. 9499 :
  253. 9500 [143] GET STATUS AND CLOSE FILES
  254. 9501 [143] N$ NEEDED
  255. 9520 [132]15,A$,B$,C$,D$
  256. 9530 [153] "NUMBER","TYPE","TRACK","BLOCK"
  257. 9540 [153] A$,B$,C$,D$
  258. 9545 [160] 2
  259. 9550 [160] 15
  260. 9560 [153] "STATUS IS "B$
  261. 9565 [153] "ANY KEY TO CONTINUE (ST="ST")"
  262. 9570 [161] A$:[139] A$[178]"" [167] 9570
  263. 9997 [142]
  264. 9998 :
  265. 9999 :
  266. 10000 [143] M$(1-12) NAME OF MONTH
  267. 10010 [143] D$(MONTH,DATE,LINE)
  268. 10020 [143] MO-MONTH
  269. 10030 [143] DA=DATE
  270. 10040 [143] Y(1) THRU Y(12) SPACES EACH MO
  271. 10041 Y[178]SPACES [145] EACH M[145]TH
  272. 10050 [143] F= LEAP YEAR FLAG
  273. 10060 [143] BK$= EMPTY SPACES
  274. 10070 [143] X$ TEMP STRING TO PRINTER
  275. 10080 [143] YE YEAR OF CALENDER
  276. 10090 [143] P$(1),TO P$(9)=PRINTER PARAMETERS
  277. 10100 [143] R$(1),TO R$(9)=PRINTER STATEMENTS
  278. 10110 [143] LF = 7 ( ADD LINE FEED )
  279. 10120 [143] OR LF=8 ( NO LINE FEED )
  280. 10130 [143]
  281. 10150 [143]
  282. 10160 [143]
  283. 10170 [143]
  284. 10180 [143]
  285. 10190 [143]
  286. 10998 :
  287. 10999 :
  288. 12000 [143] PRINT CALENDAR
  289. 12001 SM[178]1
  290. 12002 [133] "START MONTH";SM
  291. 12008 [141] 16000
  292. 12009 [141] 19000:[143] CK OFF LINE
  293. 12010 [139] F[178]O [167] Z(2)[178]28
  294. 12011 [139] F[178]1 [167] Z(2)[178]29
  295. 12015 A$[178]""
  296. 12020 [129] MO[178]SM [164] 12
  297. 12021 [139] A$[179][177]"" [167] 12542
  298. 12024 Y[178]Y(MO)
  299. 12025 X$[178]M$(MO):[141] 12800:[143] HEADING
  300. 12099 :
  301. 12100 [141] 12900:[143] ASTERICKS
  302. 12120 [129] J[178]1 [164] 4:[143] 1ST WEEK
  303. 12130 X$[178]P$(4) :[141] 12950
  304. 12135 [139] Y[178]0 [167] 12160
  305. 12140 [129] I[178]1 [164] Y:[143] SPACES
  306. 12145 X$[178]BK$:[141] 12950
  307. 12150 [130] I
  308. 12160 [129] DA[178]1 [164] 7[171]Y
  309. 12165 X$[178]D$(MO,DA,J) :[141] 12950
  310. 12170 [130] DA:X$[178]"*":[141] 12850
  311. 12172 [130] J
  312. 12173 [141] 12900
  313. 12174 :
  314. 12185 [129] J[178]1 [164] 4:[143] 2ND WEEK
  315. 12190 X$[178]P$(4):[141] 12950
  316. 12200 [129] DA[178]8[171]Y [164] 14[171]Y
  317. 12210 X$[178]D$(MO,DA,J) :[141] 12950
  318. 12215 [130] DA:X$[178]"*":[141] 12850
  319. 12216 [130] J
  320. 12220 [141] 12900:[143] ASTERICKS
  321. 12225 :
  322. 12250 [129] J[178]1 [164] 4 :[143] 3RD WEEK
  323. 12255 X$[178]P$(4) :[141] 12950
  324. 12260 [129] DA[178]15[171]Y [164] 21[171]Y
  325. 12265 X$[178]D$(MO,DA,J) :[141] 12950
  326. 12270 [130] DA:X$[178]"*":[141] 12850
  327. 12272 [130] J
  328. 12275 [141] 12900:[143] ASTERICKS
  329. 12285 :
  330. 12300 [129] J[178]1 [164] 4 :[143] 4TH WEEK
  331. 12310 X$[178]P$(4):[141] 12950
  332. 12315 [129] DA[178]22[171]Y [164] 28[171]Y
  333. 12320 X$[178]D$(MO,DA,J) :[141] 12950
  334. 12325 [130] DA:X$[178]"*":[141] 12850
  335. 12327 [130] J
  336. 12330 [141] 12900:[143] ASTERICKS
  337. 12331 [139] Z(MO)[170]Y[178]28 [167] 12541
  338. 12340 :
  339. 12349 [139] Z(MO)[170]Y[177]35 [167] 12450
  340. 12350 [129] J[178]1 [164] 4 :[143] 5TH WEEK AND LAST
  341. 12355 X$[178]P$(4): [141] 12950
  342. 12360 [129] DA[178]29[171]Y [164] Z(MO)
  343. 12365 X$[178]D$(MO,DA,J) :[141] 12950
  344. 12380 [130] DA
  345. 12385 [139] Z(MO)[170]Y[178]35 [167] 12406
  346. 12390 [129] I[178]Z(MO)[170]Y[170]1 [164] 35
  347. 12395 X$[178]BK$:[141] 12950
  348. 12400 [130] I
  349. 12406 X$[178]"*":[141] 12850
  350. 12407 [130] J
  351. 12408 [141] 12900:[137] 12541
  352. 12409 :
  353. 12450 [129] J[178]1 [164] 4 :[143] 5TH WEEK
  354. 12455 X$[178]P$(4): [141] 12950
  355. 12460 [129] DA[178]29[171]Y [164] 35[171]Y
  356. 12465 X$[178]D$(MO,DA,J) :[141] 12950
  357. 12470 [130] DA:X$[178]"*":[141] 12850
  358. 12480 [130] J
  359. 12485 [141] 12900:[143] ASTERICKS
  360. 12490 :
  361. 12500 [129] J[178]1 [164] 4 :[143] 6TH WEEK
  362. 12505 X$[178]P$(4) :[141] 12950
  363. 12510 [129] DA[178]36[171]Y [164] Z(MO)
  364. 12520 X$[178]D$(MO,DA,J) :[141] 12950
  365. 12530 [130] DA:
  366. 12532 [129] I[178]Z(MO)[170]Y[170]1 [164] 42
  367. 12534 X$[178]BK$:[141] 12950
  368. 12536 [130] I:X$[178]"*":[141] 12850
  369. 12538 [130] J
  370. 12540 [141] 12900:[143] ASTERICKS
  371. 12541 [130] MO
  372. 12542 [142]
  373. 12555 :
  374. 12600 [142]
  375. 12800 [143] PRINT HEADER
  376. 12805 [159] 4,4,LF
  377. 12810 [152]4,[199](12):[143] FF
  378. 12815 [129] I[178]1 [164] 23:[152]4," ":[130] I
  379. 12820 [152]4,P$(4) P$(1)"      "X$"   "YEAR;
  380. 12821 [152]4,P$(2)
  381. 12830 [152]4,P$(4) "     (null)UN        (null)ON        (null)UE        (null)ED";
  382. 12835 [152]4,"        (null)HUR       ASCRI        (null)AT"
  383. 12840 [160]4:[142]
  384. 12845 :
  385. 12850 [143] PRINT X$ WITH CR
  386. 12855 [159] 4,4,LF
  387. 12866 [152]4,X$
  388. 12867 [161] A$
  389. 12868 [160]4:[142]
  390. 12889 :
  391. 12900 [143] PRINT AND CR
  392. 12910 [159] 4,4,LF
  393. 12920 [152]4,P$(4) "***************************************";
  394. 12921 [152]4,"***************************************"
  395. 12930 [160]4:[142]
  396. 12940 [142]
  397. 12941 :
  398. 12950 [143] PRINT X$-NO CR
  399. 12955 [159] 4,4,LF
  400. 12966 [152]4,X$;
  401. 12968 [160]4:[142]
  402. 12998 :
  403. 12999 :
  404. 13000 [143] CLEAR SCREEN
  405. 13010 [153] [199](147):[143] CLEAR&HOME
  406. 13020 [151] 53281,0:[143] BLACK BACKGROUND
  407. 13030 [153] [199](5):[143] WHITE CHAR
  408. 13997 [142]
  409. 13998 :
  410. 13999 :
  411. 14000 [143] SET PRINTER PARAMTERS
  412. 14002 [141] 19000:[143] CK OFF LINE
  413. 14005 [153] "    EPSON MX 80 GRAFTREX PLUS"
  414. 14010 [153] "      1) DOUBLE WIDTH TITLE  "R$(1)
  415. 14020 [153] "      2) EMPHAIZED           "R$(3)
  416. 14030 [153] "      3) COMPRESSED          "R$(4)
  417. 14040 [153] "      4) CANCEL ALL          "
  418. 14050 [153] "      5) REVERSE LF COMMAND " R$(5)
  419. 14060 [153] "      6) RTN TO MAIN MENU     "
  420. 14100 [133] X
  421. 14105 [139] X[177]6 [176] X[179]1 [167] 14000
  422. 14110 [145] X [141] 14300,14400,14500,14600,14700,14750
  423. 14120 [139] X[178]6 [167] X[178]0:[142]
  424. 14130 [137] 14000
  425. 14299 :
  426. 14300 P$(1)[178][199](27)[170][199](215)[170][199](1)
  427. 14310 P$(2)[178][199](27)[170][199](215)[170][199](0)
  428. 14320 R$(1)[178]"DW ON   "
  429. 14398 [142]
  430. 14399 :
  431. 14400 [139] R$(4)[178]""[167] 14410
  432. 14401 [142]
  433. 14405 P$(4)[178]"                              "
  434. 14410 P$(3)[178][199](27)[170][199](197)
  435. 14420 R$(3)[178]"E ON   "
  436. 14430 [141] 14800
  437. 14440 [142]
  438. 14490 :
  439. 14499 :
  440. 14500 [139] R$(3)[178]"" [167] 14510
  441. 14501 [142]
  442. 14510 P$(3)[178][199](20):[141] 14800
  443. 14520 R$(4)[178]"CMP ON  "
  444. 14530 P$(4)[178]"                              "
  445. 14598 [142]
  446. 14599 :
  447. 14600 P$(1)[178]"":P$(2)[178]"":R$(1)[178]""
  448. 14601 R$(3)[178]"":R$(4)[178]""
  449. 14602 P$(4)[178]" "
  450. 14610 P$(3)[178][199](18):[141] 14800
  451. 14620 P$(3)[178][199](27)[170][199](198):[141] 14800
  452. 14698 [142]
  453. 14699 :
  454. 14700 [139] LF[178]8 [167] 14720
  455. 14710 [139] LF[178]7 [167] 14730
  456. 14720 LF[178]7:R$(5)[178]"ADD LF " :[137] 14740
  457. 14730 LF[178]8:R$(5)[178]"NO LF  ":[137] 14740
  458. 14740 [142]
  459. 14749 :
  460. 14750 [142]
  461. 14799 :
  462. 14800 [159] 4,4,LF
  463. 14810 [152]4,P$(3)
  464. 14820 [160]4
  465. 14830 [142]
  466. 14898 [142]
  467. 14899 :
  468. 14997 [142]
  469. 14998 :
  470. 14999 :
  471. 15000 [143] SCRATCH OLD FILE
  472. 15010 [133] "DATA NAME";N$
  473. 15015 [139] N$[178]"Q" [167] [142]
  474. 15020 N$[178]"SCRATCH0:"[170]N$
  475. 15030 [159] 15,8,15
  476. 15040 [152]15,N$
  477. 15050 [160]15
  478. 15055 :
  479. 15060 [141] 9000
  480. 15070 [153] N$"  DONE."
  481. 15090 [153] "ANY KEY TO CONTINUE"
  482. 15100 [161] A$:[139] A$[178]"" [167] 15100
  483. 15110 [142]
  484. 15798 :
  485. 15799 :
  486. 16000 [143]  MAKE Y1-Y12 DATA
  487. 16010 [143] F= FLAG
  488. 16020 [143] L= TEMP LEAP YEARS
  489. 16030 [143] YE=YEAR
  490. 16040 :
  491. 16050 [133] "YEAR=";YE
  492. 16100 N[178]YE[171]1978
  493. 16105 L[178]0
  494. 16110 [129] X[178]1978 [164] YE[171]1
  495. 16120 [141] 16900
  496. 16130 [139] F[178]1 [167] L[178]L[170]1
  497. 16140 [130] X
  498. 16150 X[178]YE:[141] 16900:[143] GET FLAG
  499. 16169 :
  500. 16200 Y[178]N[170]L
  501. 16210 [141] 16800
  502. 16250 :
  503. 16300 [143] NORM YEAR
  504. 16301 [139] F[178]1 [167] 16400
  505. 16310 Y(1)[178]Y:Y(10)[178]Y
  506. 16320 Y[178]Y[170]3:[141] 16800
  507. 16330 Y(2)[178]Y:Y(11)[178]Y:Y(3)[178]Y:Y[178]Y(1)
  508. 16340 Y[178]Y[170]4:[141] 16800
  509. 16350 Y(6)[178]Y:Y[178]Y(1)
  510. 16355 Y[178]Y[170]2:[141] 16800
  511. 16360 Y(8)[178]Y:Y[178]Y(1)
  512. 16365 Y[178]Y[170]5:[141] 16800
  513. 16370 Y(9)[178]Y:Y(12)[178]Y:Y[178]Y(1)
  514. 16375 Y[178]Y[170]6:[141] 16800
  515. 16380 Y(4)[178]Y:Y(7)[178]Y:Y[178]Y(1)
  516. 16385 Y[178]Y[170]1:[141] 16800
  517. 16390 Y(5)[178]Y:Y[178]Y(1)
  518. 16394 [137] 16494
  519. 16395 :
  520. 16400 [143] LEAP YEAR
  521. 16410 Y(1)[178]Y:Y(4)[178]Y:Y(7)[178]Y
  522. 16420 Y[178]Y[170]3:[141] 16800
  523. 16430 Y(2)[178]Y:Y(8)[178]Y:Y[178]Y(1)
  524. 16440 Y[178]Y[170]4:[141] 16800
  525. 16450 Y(11)[178]Y:Y(3)[178]Y:Y[178]Y(1)
  526. 16455 Y[178]Y[170]2:[141] 16800
  527. 16460 Y(5)[178]Y:Y[178]Y(1)
  528. 16465 Y[178]Y[170]5:[141] 16800
  529. 16470 Y(6)[178]Y:Y[178]Y(1)
  530. 16475 Y[178]Y[170]6:[141] 16800
  531. 16480 Y(9)[178]Y:Y(12)[178]Y:Y[178]Y(1)
  532. 16485 Y[178]Y[170]1:[141] 16800
  533. 16490 Y(10)[178]Y:Y[178]Y(1)
  534. 16494 [142]
  535. 16495 :
  536. 16800 [143] REDUCE Y
  537. 16810 Y[178]Y[171]([181](Y[173]7))[172]7
  538. 16820 [142]
  539. 16830 :
  540. 16900 [143] LOOK FOR LEAPS
  541. 16905 F[178]0
  542. 16910 [139] [181](X[173]4)[179][177](X[173]4)[167] 16997
  543. 16920 F[178]1
  544. 16930 [139] [181](X[173]100)[179][177](X[173]100)[167] 16997
  545. 16940 F[178]0
  546. 16950 [139] X[179][177]2000 [167] 16997
  547. 16960 F[178]1
  548. 16997 [142]
  549. 16998 :
  550. 16999 :
  551. 17000 [143] DISPLAY ALTERED DATES
  552. 17110 [129] MO[178]1 [164] 12
  553. 17120 J[178]2
  554. 17130 [129] DA[178]1 [164] 31
  555. 17140 [139] D$(MO,DA,J)[178]"*          "[167] 17150
  556. 17145 [141] 17200
  557. 17150 [130] DA
  558. 17170 [130] MO
  559. 17180 [142]
  560. 17185 :
  561. 17200 [143] DISPLAY
  562. 17233 [153] S$M$(MO)
  563. 17234 [153] " "
  564. 17244 [153] S$"************"
  565. 17245 [153] S$D$(MO,DA,1)"*"
  566. 17246 [153] S$D$(MO,DA,2)"*"
  567. 17247 [153] S$D$(MO,DA,3)"*"
  568. 17248 [153] S$D$(MO,DA,4)"*"
  569. 17249 [153] S$"************"
  570. 17250 A[178][194](197)
  571. 17251 [139] A$[178]"H" [167] 17250
  572. 17260 [139] A[178]60 [167] 17250:[143] STOP ON SPACE BAR
  573. 17270 [142]
  574. 17280 :
  575. 17997 [142]
  576. 17998 :
  577. 17999 :
  578. 18000 [143] RECOVER FROM DISK ERROR
  579. 18005 [160]2:[160]15
  580. 18010 [159] 15,8,15
  581. 18020 [152]15,"INITIALIZE"
  582. 18030 [160]15
  583. 18040 [142]
  584. 18998 :
  585. 18999 :
  586. 19000 [143] PRINT PRINTER OFF LINE
  587. 19010 [153] " "
  588. 19020 [153] "PRINTER OFF LINE"
  589. 19030 [159] 4,4,8
  590. 19040 [152]4," "
  591. 19045 [160]4
  592. 19050 [141] 13000
  593. 19060 [142]
  594. 19998 :
  595. 19999 :
  596. 20000 [143] WELCOME
  597. 20010 [151] 53281,0:[143] BLACK SCREEN
  598. 20020 [153] [199](5):[143] WHITE LETTERS
  599. 20030 [129] I[178]1 [164] 3:[153] "  ":[130]
  600. 20040 [153] [166]10)"WELCOME"
  601. 20045 [153] [166]3)" THIS IS FREEWARE"
  602. 20050 [153] [166]3)" IT IS DISTRIBUTED BY ALLOWING"
  603. 20060 [153] [166]3)" COPIES TO BE MADE AND GIVEN TO "
  604. 20065 [153] [166]3)" MEMBERS AND FRIENDS BY CLUBS AND"
  605. 20070 [153] [166]3)" HOBBYISTS   "
  606. 20080 [153] [166]3)" YOU ARE FREE TO USE AND DISTRBUITE"
  607. 20090 [153] [166]3)" THIS SOFTWARE AS YOU SEE FIT.  "
  608. 20100 [153]"  "
  609. 20110 [153] [166]3)" HOWEVER IT IS SUGGESTED THAT  "
  610. 20120 [153] [166]3)" A SMALL REMUNERATION BE SENT   "
  611. 20130 [153] [166]3)" TO THE AUTHOR FOR HIS WORK.    "
  612. 20140 [153] [166]3)" THE SUGGESTED AMOUNT IS FIVE (5)"
  613. 20150 [153] [166]3)" DOLLARS.  IN RETURN FOR THIS   "
  614. 20155 [153] [166]3)" PRINTED INSTRUCTIONS WILL BE "
  615. 20156 [153] [166]3)" RETURNED TO THE SENDER."
  616. 20160 [153] [166]3)"         "
  617. 20190 [153] [166]3)" REMIT TO;   A. RYDBERG        "
  618. 20200 [153] [166]3)"             RFD#1 BOX 46 C   "
  619. 20210 [153] [166]3)"             STERLING CT.  06377"
  620. 20220 [153] [166]3)"       "
  621. 20230 [153] [166]3)" ANY KEY TO PROCEED"
  622. 20240 [161] A$:[139] A$[178]"" [167] 20240
  623. 20999 [142]
  624.